home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue46 / Clinic / AutomationServer2ClassU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-03-15  |  1.6 KB  |  71 lines
  1. unit AutomationServer2ClassU;
  2.  
  3. interface
  4.  
  5. uses
  6.   ComObj, ActiveX, AutomationServer2_TLB;
  7.  
  8. type
  9.   TClock = class(TAutoObject, IClock)
  10.   private
  11.     RegistrationCookie: Integer;
  12.   protected
  13.     function Get_DateAndTime: TDateTime; safecall;
  14.     function Get_Visible: WordBool; safecall;
  15.     procedure Set_Visible(Value: WordBool); safecall;
  16.     procedure Quit; safecall;
  17.   public
  18.     procedure Initialize; override;
  19.     destructor Destroy; override;
  20.   end;
  21.  
  22. implementation
  23.  
  24. uses
  25.   ComServ, SysUtils, Forms, Windows;
  26.  
  27. procedure TClock.Initialize;
  28. begin
  29.   inherited;
  30.   OleCheck(RegisterActiveObject(Self as IUnknown, Class_Clock,
  31.       ActiveObject_Weak, RegistrationCookie));
  32.   Application.MainForm.Tag := Longint(Self);
  33.   Application.MessageBox('COM object starting', 'Information',
  34.     MB_OK or MB_ICONEXCLAMATION);
  35. end;
  36.  
  37. destructor TClock.Destroy;
  38. begin
  39.   Application.MessageBox('COM object ending', 'Information',
  40.     MB_OK or MB_ICONEXCLAMATION);
  41.   Application.MainForm.Tag := 0;
  42.   OleCheck(RevokeActiveObject(RegistrationCookie, nil));
  43.   inherited
  44. end;
  45.  
  46. function TClock.Get_DateAndTime: TDateTime;
  47. begin
  48.   Result := Now
  49. end;
  50.  
  51. function TClock.Get_Visible: WordBool;
  52. begin
  53.   Result := Application.MainForm.Visible
  54. end;
  55.  
  56. procedure TClock.Set_Visible(Value: WordBool);
  57. begin
  58.   Application.MainForm.Visible := Value;
  59.   CoLockObjectExternal(Self as IUnknown, Value, True);
  60. end;
  61.  
  62. procedure TClock.Quit;
  63. begin
  64.   CoDisconnectObject(Self as IUnknown, 0);
  65. end;
  66.  
  67. initialization
  68.   TAutoObjectFactory.Create(ComServer, TClock, Class_Clock,
  69.     ciSingleInstance, tmApartment);
  70. end.
  71.